home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / Src / symbol.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-06-03  |  2.6 KB  |  105 lines
  1. /*
  2.  *
  3.  * s y m b o l . c            -- Symbols management
  4.  *
  5.  * Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  6.  * 
  7.  *
  8.  * Permission to use, copy, and/or distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that both the above copyright notice and this permission notice appear in
  11.  * all copies and derived works.  Fees for distribution or use of this
  12.  * software or derived works may only be charged with express written
  13.  * permission of the copyright holder.  
  14.  * This software is provided ``as is'' without express or implied warranty.
  15.  *
  16.  * This software is a derivative work of other copyrighted softwares; the
  17.  * copyright notices of these softwares are placed in the file COPYRIGHTS
  18.  *
  19.  *
  20.  *           Author: Erick Gallesio [eg@kaolin.unice.fr]
  21.  *    Creation date: 20-Nov-1993 12:12
  22.  * Last file update:  3-Jun-1996 21:35
  23.  */
  24.  
  25. #include "stk.h"
  26.  
  27. static Tcl_HashTable obarray;
  28.  
  29. void STk_initialize_symbol_table(void)
  30. {
  31.   Tcl_InitHashTable(&obarray, TCL_STRING_KEYS);
  32. }
  33.  
  34. void STk_mark_symbol_table(void)
  35. {
  36.   register SCM x;
  37.   Tcl_HashEntry *ent;
  38.   Tcl_HashSearch tmp;
  39.  
  40.   for (ent=Tcl_FirstHashEntry(&obarray, &tmp); ent;  ent=Tcl_NextHashEntry(&tmp)) {
  41.     x = (SCM) Tcl_GetHashValue(ent); 
  42.     if (VCELL(x) != UNBOUND || (x->cell_info & CELL_INFO_C_VAR)) STk_gc_mark(x);
  43.   }
  44. }
  45.  
  46. void STk_free_symbol(SCM symbol)
  47. {
  48.   Tcl_DeleteHashEntry(Tcl_FindHashEntry(&obarray, PNAME(symbol)));
  49. }
  50.  
  51.  
  52. SCM STk_intern(char *name)
  53. {
  54.   Tcl_HashEntry *p;
  55.  
  56.   if (p = Tcl_FindHashEntry(&obarray, name))
  57.     return Tcl_GetHashValue(p);
  58.   else {
  59.     SCM sym;
  60.     int absent;
  61.     
  62.     /* Be careful with GC: Create hash entry after the new cell to avoid 
  63.      * partially initialized table entry 
  64.      */
  65.     NEWCELL(sym, tc_symbol);
  66.     p            = Tcl_CreateHashEntry(&obarray, name, &absent);
  67.     PNAME(sym) = Tcl_GetHashKey(&obarray, p);
  68.     VCELL(sym) = UNBOUND;
  69.     Tcl_SetHashValue(p, (ClientData) sym);
  70.     return sym;
  71.   }
  72. }
  73.  
  74.  
  75. SCM STk_global_env2list(void)
  76. {
  77.   register SCM symbol, res = NIL;
  78.   Tcl_HashEntry *ent;
  79.   Tcl_HashSearch tmp;
  80.  
  81.   for (ent=Tcl_FirstHashEntry(&obarray, &tmp); ent;  ent=Tcl_NextHashEntry(&tmp)) {
  82.     symbol = (SCM)Tcl_GetHashValue(ent);
  83.     res    = Cons(Cons(symbol, VCELL(symbol)), res);
  84.   }
  85.   return res;
  86. }
  87.  
  88.  
  89. PRIMITIVE STk_symbolp(SCM x)
  90. {
  91.   return SYMBOLP(x) ? Truth : Ntruth;
  92. }
  93.  
  94. PRIMITIVE STk_symbol2string(SCM symbol)
  95. {  
  96.   if (NSYMBOLP(symbol)) Err("symbol->string: bad symbol", symbol);
  97.   return STk_makestring(PNAME(symbol));
  98. }
  99.    
  100. PRIMITIVE STk_string2symbol(SCM string)
  101. {
  102.   if (NSTRINGP(string)) Err("string->symbol: bad string", string);
  103.   return Intern(CHARS(string));
  104. }
  105.